home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Newton / Development / souped-up-source Folder / Souped-Up.π.text < prev    next >
Text File  |  1993-11-26  |  13KB  |  461 lines
  1. // © Vers a Versa
  2. // by Theo Heselmans
  3. // Date :  20 nov 1993
  4.  
  5. constant kVersion := "v. 1.0d2";
  6. constant kTitle := "Souped-Up";
  7.  
  8. constant kAppSymbol := '|Souped-Up:VaV|;
  9. constant kPackageName := "Souped-Up:VaV";
  10. constant kAppObject := '["Souped-Up","Souped-Ups"];
  11. // ---- End Project Data ----
  12. Main :=
  13.    {TheSoupCount: nil,
  14.     TheCurrent: nil,
  15.     TheSoup: nil,
  16.     Spaces:
  17.       func(LevelNr)
  18.       begin
  19.          if LevelNr=1 then
  20.             ""
  21.          else
  22.             SubStr("                              ",0,(LevelNr-2)*6) & "--";
  23.       end,
  24.     TheData: nil,
  25.     PrintOneObject:
  26.       func(Slot,Object,Level)
  27.       begin
  28.          if Level <= TheLevel then begin
  29.             if StrLen(TheData) >1000 then return;
  30.             local Temp,Prefix;
  31.             local PrimeClass:=PrimClassOf(Object);
  32.             local Class:=ClassOf(Object);
  33.             Prefix:=if Slot = nil then "" else :Spaces(Level) & Slot & ":" & unicodeHT;
  34.             if PrimeClass='Immediate or Class='String or Class='Symbol then
  35.                begin
  36.                   //check if it could be a date (range 1923-2018)
  37.                   Temp:=if Class='Int and Object > 10000000 and Object < 60000000 then ShortDate(Object) && date(Object).year else Object;
  38.                   :Append(Prefix & :PrintObject(Temp),if Slot then unicodeCR else ", ");
  39.                end;
  40.             else if Class = 'Array or PrimeClass = 'Array then
  41.                begin
  42.                   :Append(Prefix & length(object) & "[",nil);
  43.                   foreach value in Object do
  44.                      :PrintOneObject(nil,Value,Level+1);
  45.                   :Append("]",unicodeCR);
  46.                end;
  47.             else if Class = 'Frame or PrimeClass = 'Frame then
  48.                begin
  49.                   :Append(Prefix & length(object) & "{Frame}",unicodeCR);
  50.                   foreach slotname,value in Object do
  51.                      :PrintOneObject(sPrintObject(Slotname),Value,Level+1);
  52.                end;
  53.             else
  54.                begin
  55.                  Temp:=:PrintObject(object);
  56.                  if strEqual(Temp,"") then
  57.                    :Append(Prefix & "<Unknown: " & sPrintObject(PrimeClass) & ", " & sPrintObject(Class) & ">",if Slot then unicodeCR else ", ");
  58.                  else
  59.                    :Append(Prefix & Temp,if Slot then unicodeCR else ", ");
  60.                end;
  61.          end;
  62.        end,
  63.     viewBounds: {left: 0, top: 0, right: 240, bottom: 336},
  64.     _proto: protoapp,
  65.     TheStore: nil,
  66.     TheIndex: nil,
  67.     TheLevel: 1,
  68.     TheCursor: nil,
  69.     TheEntry: nil,
  70.     viewScrollDownScript:
  71.       func()
  72.       begin
  73.          if TheCurrent<TheSoupCount then begin
  74.             TheCursor:Next();
  75.             TheCurrent:=TheCurrent+1;
  76.             :GetEntry();
  77.          end;
  78.       end,
  79.     title: "Souped-Up",
  80.     viewScrollUpScript:
  81.       func()
  82.       begin
  83.          if TheCurrent>1 then begin
  84.             TheCursor:Prev();
  85.             TheCurrent:=TheCurrent-1;
  86.             :GetEntry();
  87.          end;
  88.       end,
  89.     PrintObject:
  90.       func(object)
  91.       begin
  92.          if object = nil then return "NIL";
  93.          if object = true then "TRUE"
  94.          else sPrintObject(Object);
  95.       end,
  96.     viewSetupFormScript:
  97.       func()
  98.       begin
  99.          Title:=kTitle;
  100.          local sysSoup := GetStores()[0]:GetSoup(ROM_SystemSoupName);
  101.          local cursor := Query(sysSoup,{type: 'index, indexPath: 'tag, startKey: kPackageName});
  102.          prefsEntry := cursor:Entry();
  103.          if NOT (prefsEntry AND StrEqual(prefsEntry.tag,kPackageName)) then
  104.             prefsEntry := sysSoup:Add({tag: kPackageName, StoreNr:0, SoupNr:0, IndexNr:0, EntryNr:1, LevelNr:1});
  105.       end,
  106.     prefsEntry: nil,
  107.     debug: "Main",
  108.     GetEntry:
  109.       func()
  110.       begin
  111.          :Append(nil,nil);
  112.          prefsEntry.EntryNr:=TheCurrent;
  113.          TheEntry:=clone(TheCursor:Entry());
  114.          if TheEntry = nil then
  115.             Count.Text:="No Data";
  116.          else begin
  117.             foreach slot,value in TheEntry do begin
  118.                :PrintOneObject(sPrintObject(Slot),Value,1);
  119.                if StrLen(TheData) >1000 then begin
  120.                   :Append("------------",UnicodeCR);
  121.                   :Append("<More Slots here>",UnicodeCR);
  122.                   :Append("<Due to Memory problem, have to stop here>",nil);
  123.                   Break;
  124.                end;
  125.             end;
  126.             EntryUndoChanges(TheEntry);
  127.             Count.Text:=NumberStr(TheCurrent)&" of "&NumberStr(TheSoupCount);
  128.          end;
  129.          ListView.ViewOriginY:=0;
  130.          setvalue(List,'text,TheData & " ");
  131.          TheData:=nil;
  132.          TheEntry:=nil;
  133.          setvalue(List,'viewbounds,List.viewbounds); //to force recalc of bounds (bug in clparagraphview)
  134.          ListView.ViewMaxY := List:LocalBox().bottom - ListView:LocalBox().bottom + 1;
  135.          Count:Dirty();
  136.          EntryChange(prefsEntry);  // save at the end, so in case of a memory error, previous prefs is restored
  137.       end,
  138.     Append:
  139.       func(String,Suffix)
  140.       begin
  141.          if String=nil then
  142.             TheData:="";
  143.          else begin
  144.             TheData:=Stringer([TheData,if Suffix then Stringer([String,Suffix]) else String]);
  145.          end;
  146.        end,
  147.     CountSoup:
  148.       func ()
  149.       begin
  150.          local count:=1, cursor:=TheCursor:Clone();
  151.          cursor:Reset();
  152.          if cursor:Entry() = NIL then
  153.             TheSoupCount:= 0;
  154.          else begin
  155.             while cursor:Next() do count := count + 1;
  156.             TheSoupCount:=Count;
  157.          end;             
  158.       end
  159.       
  160.    };
  161.  
  162. ListView := /* child of Main */
  163.    {viewflags: 67108897,
  164.     viewFormat: 336,
  165.     viewBounds: {top: 30, left: 1, right: -15, bottom: 303},
  166.     viewJustify: 48,
  167.     viewOriginY: 0,
  168.     viewMaxY: nil,
  169.     ViewScrollAmount: 100,
  170.     viewclass: 74,
  171.     debug: "ListView"
  172.    };
  173.  
  174. List := /* child of ListView */
  175.    {viewBounds: {top: 1, left: 2, right: -2, bottom: 253},
  176.     viewfont: ROM_fontSystem9,
  177.     viewflags: 11,
  178.     viewFormat: 131073,
  179.     viewJustify: 48,
  180.     text: "Entry Info",
  181.     tabs: [70],
  182.     _proto: protostatictext,
  183.     debug: "List"
  184.    };
  185. // View List is accesible from Main
  186.  
  187.  
  188. // View ListView is accesible from Main
  189.  
  190.  
  191.  
  192. Level := /* child of Main */
  193.    {viewBounds: {left: 159, top: 305, right: 241, bottom: 319},
  194.     labelCommands: ["1","2","3","4"],
  195.     viewSetupDoneScript:
  196.       func()
  197.       begin
  198.          TheLevel:=prefsEntry.LevelNr;
  199.          :UpdateText(Labelcommands[TheLevel-1]);
  200.       end,
  201.     labelActionScript:
  202.       func(cmd)
  203.       begin
  204.          TheLevel:=cmd+1;
  205.          prefsEntry.LevelNr:=TheLevel;
  206.          :GetEntry();
  207.       end,
  208.     text: "Level",
  209.     _proto: protolabelpicker,
  210.     debug: "Level"
  211.    };
  212. // View Level is accesible from Main
  213.  
  214.  
  215.  
  216. Store := /* child of Main */
  217.    {viewBounds: {left: 3, top: 15, right: 103, bottom: 29},
  218.     labelCommands: ["Internal"],
  219.     text: "Store",
  220.     labelActionScript:
  221.       func(cmd)
  222.       begin
  223.          TheStore:=GetStores()[cmd];
  224.          prefsEntry.StoreNr:=cmd;
  225.          prefsEntry.SoupNr:=0;
  226.          prefsEntry.IndexNr:=0;
  227.          prefsEntry.EntryNr:=1;
  228.          Soup:Getsoups();
  229.          Index:GetIndexes();
  230.          Index:GetData();
  231.       end,
  232.     viewSetupDoneScript:
  233.       func()
  234.       begin
  235.          local Counter, Stores:=array(0,Nil), NrStores:=Length(GetStores())-1;
  236.          for Counter:=0 to NrStores do
  237.             AddArraySlot(Stores,GetStores()[Counter]:GetName());
  238.          LabelCommands:=Stores;
  239.          if prefsEntry.StoreNr>NrStores then prefsEntry.StoreNr:=0;
  240.          :Updatetext(LabelCommands[prefsEntry.StoreNr]);
  241.          TheStore:=GetStores()[prefsEntry.StoreNr];
  242.       end,
  243.     _proto: protolabelpicker,
  244.     debug: "Store"
  245.    };
  246. // View Store is accesible from Main
  247.  
  248.  
  249.  
  250. Soup := /* child of Main */
  251.    {viewBounds: {left: 105, top: 15, right: 241, bottom: 29},
  252.     labelCommands: ["System"],
  253.     text: "Soup",
  254.     GetSoups:
  255.       func()
  256.       begin
  257.          LabelCommands:=TheStore:GetSoupNames();
  258.          if prefsEntry.SoupNr > (Length(LabelCommands)-1) then prefsEntry.SoupNr:=0;
  259.          TheSoup:=TheStore:GetSoup(LabelCommands[prefsEntry.SoupNr]);
  260.          :Updatetext(LabelCommands[prefsEntry.SoupNr]);
  261.       end,
  262.     viewSetupDoneScript:
  263.       func()
  264.       begin
  265.          :GetSoups();
  266.       end,
  267.     labelActionScript:
  268.       func(cmd)
  269.       begin
  270.          TheSoup:=TheStore:GetSoup(LabelCommands[cmd]);
  271.          prefsEntry.SoupNr:=cmd;
  272.          prefsEntry.IndexNr:=0;
  273.          prefsEntry.EntryNr:=1;
  274.          Index:GetIndexes();
  275.          Index:GetData();
  276.       end,
  277.     _proto: protolabelpicker,
  278.     debug: "Soup"
  279.    };
  280. // View Soup is accesible from Main
  281.  
  282.  
  283.  
  284. Index := /* child of Main */
  285.    {viewBounds: {left: 3, top: 305, right: 157, bottom: 319},
  286.     labelCommands: ["index 1","index 2"],
  287.     GetIndexes:
  288.       func()
  289.       begin
  290.          local List:=array(0,Nil), Counter, Indexes:=TheSoup:GetIndexes();
  291.          if Indexes <> nil then
  292.             for Counter:=0 to length(Indexes)-1 do
  293.                AddArraySlot(List,sPrintobject(Indexes[Counter].path));
  294.          else List:=[""];
  295.          Labelcommands:=list;
  296.          if prefsEntry.IndexNr>(Length(Indexes)-1) then prefsEntry.IndexNr:=0;
  297.          :UpdateText(List[prefsEntry.IndexNr]);
  298.          TheIndex:=if Indexes = nil then nil else List[prefsEntry.IndexNr];
  299.       end,
  300.     labelActionScript:
  301.       func(cmd)
  302.       begin
  303.          TheIndex:=labelcommands[cmd];
  304.          prefsEntry.IndexNr:=cmd;
  305.          prefsEntry.EntryNr:=1;
  306.          :GetData();
  307.       end,
  308.     text: "Index",
  309.     viewSetupDoneScript:
  310.       func()
  311.       begin
  312.          :GetIndexes();
  313.          :GetData();
  314.       end,
  315.     GetData:
  316.       func()
  317.       begin
  318.          TheCursor:=query(TheSoup,{type:'index, indexpath: (if TheIndex then intern(TheIndex) else 'uniqueID)});
  319.          :CountSoup();
  320.          if prefsEntry.EntryNr> TheSoupCount then prefsEntry.EntryNr:=1;
  321.          TheCurrent:=prefsEntry.EntryNr;
  322.          if TheCurrent>1 then TheCursor:Move(TheCurrent-1);
  323.          :GetEntry();
  324.       end,
  325.     _proto: protolabelpicker,
  326.     debug: "Index"
  327.    };
  328. // View Index is accesible from Main
  329.  
  330.  
  331.  
  332. About := /* child of Main */
  333.    {viewBounds: {left: 4, top: 38, right: 192, bottom: 234},
  334.     viewSetupDoneScript:
  335.       func()
  336.       begin
  337.          VersionField.Text:=kVersion;
  338.       end,
  339.     _proto: protofloatngo,
  340.     debug: "About"
  341.    };
  342.  
  343. _view000 := /* child of About */
  344.    {
  345.     text:
  346.       "Souped-Up lets you browse through any Soup entry by entry, independent of the soups structure.\nThanks to Matthew Dixon Cowles, from whom I borrowed some ideas in his 'Pour' code.\n\nA free tool offered to you by...\n\nTheo Heselmans\n\u00A9\u Vers a Versa, 1993\n"
  347.     ,
  348.     viewBounds: {left: 8, top: 34, right: 192, bottom: 184},
  349.     viewJustify: 0,
  350.     _proto: protostatictext
  351.    };
  352.  
  353.  
  354.  
  355. VavIcon := /* child of About */
  356.    {viewflags: 3,
  357.     icon: GetPictAsBits("VaV Pict", nil),
  358.     viewFormat: nil,
  359.     viewBounds: {left: 8, top: 2, right: 56, bottom: 34},
  360.     viewclass: 76,
  361.     debug: "VavIcon"
  362.    };
  363.  
  364.  
  365.  
  366. VersionField := /* child of About */
  367.    {text: "v. 1.0",
  368.     viewBounds: {left: 8, top: 184, right: 64, bottom: 205},
  369.     viewfont: simpleFont9,
  370.     _proto: protostatictext,
  371.     debug: "VersionField"
  372.    };
  373. // View VersionField is accesible from About
  374.  
  375.  
  376. // View About is accesible from Main
  377.  
  378.  
  379.  
  380. Info := /* child of Main */
  381.    {viewBounds: {top: -16, left: 40, right: 53, bottom: -3},
  382.     buttonClickScript:
  383.       func()
  384.       begin
  385.          About:Open();
  386.       end,
  387.     viewJustify: 134,
  388.     icon: GetPictAsBits("Info", nil),
  389.     _proto: protopicturebutton,
  390.     debug: "Info"
  391.    };
  392. // View Info is accesible from Main
  393.  
  394.  
  395.  
  396. Count := /* child of Main */
  397.    {viewBounds: {top: -16, left: 0, right: 60, bottom: -3},
  398.     text: "1 of x",
  399.     viewJustify: 8388758,
  400.     viewFormat: 337,
  401.     _proto: protostatictext,
  402.     debug: "Count"
  403.    };
  404. // View Count is accesible from Main
  405.  
  406.  
  407.  
  408. Up := /* child of Main */
  409.    {viewBounds: {left: 226, top: 146, right: 242, bottom: 162},
  410.     viewFormat: 1,
  411.     buttonPressedScript:
  412.       func()
  413.       begin
  414.          if ListView.ViewOriginY>0 then begin
  415.             local NewY:=ListView.ViewOriginY-ListView.ViewScrollAmount;
  416.             if NewY < 0 then NewY:=0;
  417.             ListView:SetOrigin(0,NewY);
  418.             Refreshviews();
  419.          end;
  420.       end,
  421.     _proto: protopicturebutton,
  422.     debug: "Up"
  423.    };
  424.  
  425. // After Script for "Up"
  426. thisView := Up;
  427. begin
  428.    thisview.icon:=ROM_uparrowbitmap;
  429. end
  430. // View Up is accesible from Main
  431.  
  432.  
  433.  
  434. Down := /* child of Main */
  435.    {viewBounds: {left: 226, top: 167, right: 242, bottom: 183},
  436.     viewFormat: 1,
  437.     buttonPressedScript:
  438.       func()
  439.       begin
  440.          if ListView.ViewOriginY<ListView.ViewMaxY then begin
  441.             local NewY:=ListView.ViewOriginY+ListView.ViewScrollAmount;
  442.             if NewY > ListView.ViewMaxY then NewY:=ListView.ViewMaxY;
  443.             ListView:SetOrigin(0,NewY);
  444.             Refreshviews();
  445.          end;
  446.       end,
  447.     _proto: protopicturebutton,
  448.     debug: "Down"
  449.    };
  450.  
  451. // After Script for "Down"
  452. thisView := Down;
  453. begin
  454.    thisview.icon:=ROM_downarrowbitmap;
  455. end
  456. // View Down is accesible from Main
  457.  
  458.  
  459.  
  460.  
  461.